www.gusucode.com > 简约论坛 V3.1 > 简约论坛 V3.1\code\inc\ubb_cls.asp
<%Const MaxLoopcount=100%>
<script language=vbscript runat=server>
Class Cls_IUBB
Public UbbString,Re
Private Sub Class_Initialize()
Set re=new RegExp
re.IgnoreCase =True
re.Global=True
End Sub
Private Sub class_terminate()
Set Re=Nothing
End Sub
Rem 入口(内容，1=帖子|2=留言公告等)
Public Function Ubb(Str,PostType)
If isNull(Str) or Str="" then
Ubb=""
Exit function
End if
If UbbString="" Or IsNull(UbbString) Then
UbbString=BBS.Fun.UbbString(Str)
End If
If instr(UbbString,",41,")>0 And PostType=1 Then
Str=BBS_HtmlCode(Str,PostType)
Else
Str=IUBB(str,postType)
End If
UBB=Str
End Function
Private Function IUBB(Str,PostType)
Dim Temp
If isNull(Str) or Str="" then
IUBB=""
Exit function
End if
Str=Html_Code(Str)
If InStr(UbbString,",no,")>0 Then
'Str = server.htmlencode(Str)
IUBB="<form><div style='border:solid 1px #6D683D;background-color:#AAA'><span style='line-height:22px'><b>此帖内容含有错误标记：</b></span><div style='text-align :center;'><textarea style='border:solid 1px #EEE;width:99%;' name='dbg' rows='10' id='dbgno'>" & text_encode(Str) & "</textarea></div> <div style='float:right;text-align :right'><img src='Images/icon/plus.gif' style='cursor:pointer' onclick=""code_Size(5,document.getElementById('dbgno'))"" alt='增加编辑框的高度' /> <img src='Images/icon/minus.gif' style='cursor:pointer' onclick=""code_Size(-5,document.getElementById('dbgno'))"" alt='减小输入框的高度' /> </div><div><input type='button' class='button' value='运行此代码' style='width:80px' onclick='runit(this.form.dbg)'></div></div></form>"
Exit Function
End If
re.Pattern="<img.[^>]*src(=| )(.[^>]*)>"
str=re.replace(str,"<img src=$2>")
If InStr(UbbString,",0,")>0 Then
re.pattern="((javascript:)|(jscript:)|(object)|(js:)|(location.)|(vbscript:)|(vbs:)|(\.value)|(about:)|(file:)|(document.cookie)|(on(mouse|exit|error|click|key|load)))"
str=re.replace(str,"<span style='color:#000'>$1</span>")
End If
If InStr(UbbString,",31,")>0 Then Str=IUBB1(Str,"\[quote\]","\[\/quote\]","<table cellpadding=0 cellspacing=0 border=1 WIDTH='90%' style='border-collapse: collapse' bordercolor=red align=center><tr><td bgcolor='#f2f8ff'><p style='margin:15'>$1</p></td></tr></table><br>")
If InStr(UbbString,",39,")>0 Then Str=IUBB_Reply(Str,PostType)
If InStr(UbbString,",40,")>0 Then Str=IUBB_Buy(Str,PostType)
If InStr(UbbString,",32,")>0 Then Str=BBS_GetUBB(Str,"\[coin=*([0-9]*)\]","\[\/coin\]","$1<hr noshade size=1><font color=gray>以下内容需要金钱数达到<B>$3</B>才可以浏览</font><BR>$4<hr noshade size=1>$6","$1<hr noshade size=1><font color=Red>以下内容需要金钱数达到<B>$3</B>才可以浏览</font><hr noshade size=1>$6",PostType,32)
If InStr(UbbString,",33,")>0 Then Str=BBS_GetUBB(Str,"\[mark=*([0-9]*)\]","\[\/mark\]","$1<hr noshade size=1><font color=gray>以下内容需要积分数达到<B>$3</B>才可以浏览</font><BR>$4<hr noshade size=1>$6","$1<hr noshade size=1><font color=Red>以下内容需要积分数达到<B>$3</B>才可以浏览</font><hr noshade size=1>$6",PostType,33)
If InStr(UbbString,",35,")>0 Then Str=IUBB_Login(Str,PostType)
If InStr(UbbString,",36,")>0 Then Str=IUBB_Sex(Str,PostType)
If InStr(UbbString,",37,")>0 Then Str=IUBB_Name(Str,PostType)
If InStr(UbbString,",38,")>0 Then Str=IUBB_Date(Str,PostType)
If InStr(UbbString,",27,")>0 Then Str=IUBB2(Str,"\[flash\]","\[\/flash\]","<OBJECT codeBase='http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=4,0,2,0' classid='clsid:D27CDB6E-AE6D-11cf-96B8-444553540000' width='480' height='365'><PARAM name='movie' VALUE=""$1""><PARAM name='quality' VALUE=high><embed src=""$1"" quality='high' pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash' width='500' height='400'>$2</embed></OBJECT>","",BBS.Info(66))
If InStr(UbbString,",7,")>0 Then Str=IUBB1(Str,"\[b\]","\[\/b\]","<b>$1</b>")
If InStr(UbbString,",8,")>0 Then Str=IUBB1(Str,"\[i\]","\[\/i\]","<i>$1</i>")
If InStr(UbbString,",9,")>0 Then Str=IUBB1(Str,"\[u\]","\[\/u\]","<u>$1</u>")
If InStr(UbbString,",10,")>0 Then Str=IUBB1(Str,"\[sup\]","\[\/sup\]","<sup>$1</sup>")
If InStr(UbbString,",11,")>0 Then Str=IUBB1(Str,"\[sub\]","\[\/sub\]","<sub>$1</sub>")
If InStr(UbbString,",12,")>0 Then Str=IUBB1(Str,"\[color=((#.{6})|.{3,6})\]","\[\/color\]","<font color=$1>$3</font>")
If InStr(UbbString,",13,")>0 Then Str=IUBB1(Str,"\[url=(.{5,}?)\]","\[\/url\]","<a href=""$1"" target='_blank'>$2</a>")
If InStr(UbbString,",14,")>0 Then Str=IUBB1(Str,"\[right\]","\[\/right\]","<div align=right>$1</div>")
If InStr(UbbString,",15,")>0 Then Str=IUBB1(Str,"\[light\]","\[\/light\]","<span style=""behavior:url(inc/font.htc)"">$1</span>")
If InStr(UbbString,",17,")>0 Then Str=IUBB1(Str,"\[size=([1-7])\]","\[\/size\]","<font size=$1>$2</font>")
If InStr(UbbString,",18,")>0 Then Str=IUBB1(Str,"\[dir=([0-9]{1,3}),([0-9]{1,3})\]","\[\/dir\]","<object classid=clsid:166B1BCA-3F9C-11CF-8075-444553540000 codebase=http://download.macromedia.com/pub/shockwave/cabs/director/sw.cab#version=7,0,2,0 width=$1 height=$2><param name=src value=$3><embed src=$3 pluginspage=http://www.macromedia.com/shockwave/download/ width=$1 height=$2></embed></object>")
If InStr(UbbString,",19,")>0 Then Str=IUBB1(Str,"\[fly\]","\[\/fly\]","<marquee width=90% behavior=alternate scrollamount=3>$1</marquee>")
If InStr(UbbString,",21,")>0 Then Str=IUBB1(Str,"\[align=(center|left|right)\]","\[\/align\]","<div align=$1>$2</div>")
If InStr(UbbString,",22,")>0 Then Str=IUBB1(Str,"\[shadow=*([0-9]*),*(#*[a-z0-9]*),*([0-9]*)\]","\[\/shadow\]","<table width=$1 ><tr><td style=""filter:shadow(color=$2, stregExngth=$3)"">$4</td></tr></table>")
If InStr(UbbString,",23,")>0 Then Str=IUBB1(Str,"\[sound\]","\[\/sound\]","<a href=""$1"" target=_blank><IMG SRC=Pic/FileType/mid.gif border=0 alt='背景音乐'></a><bgsound src=""$1"" loop=""-1"">")
If InStr(UbbString,",24,")>0 Then Str=IUBB2(Str,"\[img\]","\[\/img\]","<img src=$1>","<a href=$1 target=_blank>$1</a>",BBS.Info(65))
Str=IUBB1(Str,"\[cc\]","\[\/cc\]","<object classid=""clsid:D27CDB6E-AE6D-11cf-96B8-444553540000"" codebase=""http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=6,0,29,0"" width=""438"" height=""387""><param name=""movie"" value=""http://union.bokecc.com/$1""><param name=""allowFullScreen"" value=""true""><param name=""quality"" value=""high""><embed src=""http://union.bokecc.com/$1"" quality=""high"" pluginspage=""http://www.macromedia.com/go/getflashplayer"" type=""application/x-shockwave-flash"" width=""438"" height=""387""></embed></object>")
Str=JsImg(Str,550)
If InStr(UbbString,",16,")>0 Then re.pattern="\[em*([0-9]*)]":str=re.replace(str,"<img src=pic/emot/em$1.gif>")
If InStr(UbbString,",25,")>0 Then
If BBS.Info(39)="1" Then
Temp="<fieldset><legend>上传的动画</legend><br><img src='Pic/FileType/$1.gif' align='absmiddle' /> <A HREF=""ViewFile.asp?FileName=$5"" TARGET=""_blank"">$5</a> [ <font color=blue>$2</font> KB ] <font color=""#999999"">(缩略时请点打开新窗口)</font><br><br> <object classid=""clsid:D27CDB6E-AE6D-11cf-96B8-444553540000"" codebase=""http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=7,0,19,0"" width=""480"" height=""400""><param name=""movie"" value="""&BBS.Info(36)&"/$5"" /><param name=""quality"" value=""high"" /><embed src="""&BBS.Info(36)&"/$5"" quality=""high"" pluginspage=""http://www.macromedia.com/go/getflashplayer"" type=""application/x-shockwave-flash"" width=""480"" height=""400""></embed></object><br><br></fieldset>"
Else
Temp="<param name=""movie"" value="""&BBS.Info(36)&"$5"" /><param name=""quality"" value=""high"" /><embed src="""&BBS.Info(36)&"/$5"" quality=""high"" pluginspage=""http://www.macromedia.com/go/getflashplayer"" type=""application/x-shockwave-flash"" width=""480"" height=""400""></embed></object>"
End If
Str=IUBB2(Str,"\[upload=(swf|swi),*(#*[0-9\.]*),0,*(#*[0-9\.]*),*(#*[0-9\.]*)\]","\[\/upload\]",Temp,"<A HREF=""ViewFile.asp?FileName=$6"" TARGET='_blank'><img src='Pic/FileType/swf.gif' border=0 alt='动画文件' />[此处含有一FLASH动画，点击观看]</a>",BBS.Info(66))
IF BBS.Info(39)="1" Then
Temp="<fieldset><legend>上传的图片</legend><br> <img src='Pic/FileType/$1.gif' align='absmiddle' /> <A HREF=""ViewFile.asp?FileName=$6"" TARGET=_blank>$6</a> [ <font color=blue>$2</font> KB <font color=blue>$4</font>×<font color=blue>$5</font> ] <font color=#999999>(缩略时请点击查看原图)</font><br><br> <img useMap=""#Map"" SRC=""ViewFile.asp?FileName=$6"" border=""0"" width=""$3"" /><br><br></fieldset>"
Else
Temp="<A HREF=""viewfile.asp?filename=$6"" TARGET=_blank>$6</a><img useMap=""#Map"" SRC=""ViewFile.asp?FileName=$6"" border=""0"" width=""$3"" /></a>"
End If
Str=IUBB2(Str,"\[upload=("&BBS.Info(35)&"),*(#*[0-9\.]*),([0-9]{1,3}),*(#*[0-9\.]*),*(#*[0-9\.]*)\]","\[\/upload\]",Temp,"<A HREF=""ViewFile.asp?FileName=$6"" TARGET=_blank>$6</a>",BBS.Info(65))
If BBS.Info(39)="1" Then
Temp="<fieldset><legend>上传的附件</legend><br> <IMG SRC=Pic/FileType/$1.gif align=absmiddle> <a href=""ViewFile.asp?FileName=$6"" TARGET=_blank>$6</a> [ <font color=blue>$2</font> KB ]<br><br></fieldset>"
Else
Temp="<IMG SRC=Pic/FileType/$1.gif align=absmiddle> <a href=""viewfile.asp?filename=$6"" TARGET=_blank>$6</a> [ <font color=blue>$2</font> KB ]"
End If
Str=IUBB3(Str,"\[upload=("&BBS.Info(34)&"),*(#*[0-9\.]*),*(#*[0-9\.]*),*(#*[0-9\.]*),*(#*[0-9\.]*)\]","\[\/upload\]",Temp)
End If
If InStr(UbbString,",20,")>0 Then Str=IUBB1(Str,"\[move\]","\[\/move\]","<MARQUEE scrollamount=3>$1</marquee>")
If InStr(UbbString,",26,")>0 Then
re.pattern="\[EMAIL\]([^\s@]+@[^\.]+\..+?)\[\/EMAIL\]"
str=re.replace(str,"<a href=""mailto:$1"" target='_blank'>$1</a>")
re.pattern="\[EMAIL=([^\s@]+@[^\.]+?\..+?)\](.+?)\[\/EMAIL\]"
str=re.replace(str,"<a href=""mailto:$1"" target='_blank'>$2</a>")
End If
If InStr(UbbString,",30,")>0 Then Str=IUBB1(Str,"\[ra\]","\[\/ra\]","<object classid=CLSID:6BF52A52-394A-11d3-B153-00C04F79FAA6 class=OBJECT id=RAOCX width=280 height=64><param name=UIMode value=full><param name=volume value=100><param name=AutoStart value=true><param name=Enabled value=true><param name=enableContextMenu value=false><param name=URL value=$1></object>")
If InStr(UbbString,",42,")>0 Then Str=IUBB1(Str,"\[face=(.[^\[]*)\]","\[\/face\]","<font face=""$1"">$2</font>")
If InStr(UbbString,",28,")>0 Then Str=IUBB1(Str,"\[mp=([0-9]{1,3}),([0-9]{1,3})\]","\[\/mp\]","<br><object align=middle classid=CLSID:22d6f312-b0f6-11d0-94ab-0080c74c7e95 class=OBJECT id=MediaPlayer width=450 height=360 >" & vbcrlf & "<PARAM NAME=EnableContextMenu VALUE=false>" & vbcrlf & "<param name=ShowStatusBar value=-1>" & vbcrlf & "<param name=Filename value=""$3"">" & vbcrlf & "<embed type=application/x-oleobject codebase=http://activex.microsoft.com/activex/controls/mplayer/en/nsmp2inf.cab#Version=5,1,52,701 flename=mp src=""$3"" width=450 height=360>" & vbcrlf & "</embed>" & vbcrlf & "</object>")
If InStr(UbbString,",29,")>0 Then Str=IUBB1(Str,"\[rm=*([0-9]*),*([0-9]*)\]","\[\/rm\]","<br><OBJECT classid=clsid:CFCDAA03-8BE4-11cf-B84B-0020AFBBCCFA class=OBJECT id=RAOCX width=$1 height=$2>" & vbcrlf & "<PARAM NAME=SRC VALUE=$3>" & vbcrlf & "<PARAM NAME=CONSOLE VALUE=Clip1>" & vbcrlf & "<PARAM NAME=CONTROLS VALUE=imagewindow>" & vbcrlf & "<PARAM NAME=AUTOSTART VALUE=false>" & vbcrlf & "</OBJECT>" & vbcrlf & "<br>" & vbcrlf & "<OBJECT classid=CLSID:CFCDAA03-8BE4-11CF-B84B-0020AFBBCCFA height=32 id=video2 width=$1>" & vbcrlf & "<PARAM NAME=SRC VALUE=$3>" & vbcrlf & "<PARAM NAME=AUTOSTART VALUE=0>" & vbcrlf & "<PARAM NAME=CONTROLS VALUE=controlpanel>" & vbcrlf & "<PARAM NAME=CONSOLE VALUE=Clip1>" & vbcrlf & "</OBJECT>")
If BBS.Info(82)="1" Then
Rem 自动识别网址
If InStr(UbbString,",2,")>0 Or InStr(UbbString,",3,")>0 Or InStr(UbbString,",4,")>0 Or InStr(UbbString,",5,")>0 Or InStr(UbbString,",6,")>0 Then
re.Pattern = "^((http|https|ftp|rtsp|mms):(\/\/|\\\\)[A-Za-z0-9\./=\?%\-&_~`@[\]\':+!]+([^<>""])+)"
str = re.Replace(str,"<a target=_blank href=""$1"">$1</a>")
re.Pattern = "((http|https|ftp|rtsp|mms):(\/\/|\\\\)[A-Za-z0-9\./=\?%\-&_~`@[\]\':+!]+([^<>""])+)$([^\[]*)"
str = re.Replace(str,"<a target=_blank href=""$1"">$1</a>")
re.Pattern = "(^|[^<=""])((http|ftp):(\/\/|\\\\)(([\w\/\\\+\-~`@:%])+\.)+([\w\/\\\.\=\?\+\-~`@\':!%#]|(&)|&)+)"
str = re.Replace(str,"$1<a target=_blank href=""$2"">$2</a>")
End If
Rem 自动识别www等开头的网址
If InStr(UbbString,",1,")>0 Then
re.Pattern = "([\s])((www|cn)[.](\w)+[.]{1,}(net|com|cn|org|cc)(((\/[\~]*|\\[\~]*)(\w)+)|[.](\w)+)*(((([?](\w)+){1}[=]*))*((\w)+){1}([\&](\w)+[\=](\w)+)*)*)"
str = re.Replace(str,"<a target=_blank href=""http://$2"">$2</a>")
End If
End If
IUBB=Str
End function
Private Function JsImg(str,MaxSize)
Dim s
s=str
re.Pattern="<img(.[^>]*)>"
s=re.replace(s,"<img$1 onload=""return imgzoom(this,"&MaxSize&")"" border=0 onclick=""javascript:window.open(this.src);"" style=""cursor: pointer"" useMap=#Map>")
JsImg=s
End Function
Private Function Html_Code(byval Str)
If IsNull(Str) then
Html_code=""
Else
re.Pattern="(>)"&chr(13)&chr(10)&"(<)"
Str=re.Replace(Str,"$1$2")
re.Pattern="(>)"&chr(13)&"(<)"
Str=re.Replace(Str,"$1$2")
re.Pattern="(>)"&chr(10)&"(<)"
Str=re.Replace(Str,"$1$2")
Str=replace(Str, chr(13)&chr(10), "<br>")
Str=replace(Str, chr(13), "<br>")
Str=replace(Str, chr(10), "<br>")
Str=replace(Str, " ", " ")
Html_Code=Str
End if
End Function
Public Function Sign_Code(byval Str)
If IsNull(Str) or Str="" Then
Sign_Code=""
Exit Function
End If
Str=Html_Code(Str)
re.pattern="((javascript:)|(jscript:)|(object)|(js:)|(location.)|(vbscript:)|(vbs:)|(\.value)|(about:)|(file:)|(document.cookie)|(on(mouse|exit|error|click|key|load)))"
str=re.replace(str,"<font color='#000000'>$1</font>")
If InStr(Lcase(Str),"[/b]")>0 Then Str=IUBB1(Str,"\[b\]","\[\/b\]","<b>$1</b>")
If InStr(Lcase(Str),"[/i]")>0 Then Str=IUBB1(Str,"\[i\]","\[\/i\]","<i>$1</i>")
If InStr(Lcase(Str),"[/u]")>0 Then Str=IUBB1(Str,"\[u\]","\[\/u\]","<u>$1</u>")
If InStr(Lcase(Str),"[/color]")>0 Then Str=IUBB1(Str,"\[color=((#.{6})|.{3,6})\]","\[\/color\]","<font color=#$1>$3</font>")
If InStr(Lcase(Str),"[/url]")>0 Then Str=IUBB1(Str,"\[url=(.{5,}?)\]","\[\/url\]","<a href=""$1"" target='_blank'>$2</a>")
If InStr(Lcase(Str),"[/right]")>0 Then Str=IUBB1(Str,"\[right\]","\[\/right\]","<div align=right>$1</div>")
If InStr(Lcase(Str),"[/light]")>0 Then Str=IUBB1(Str,"\[light\]","\[\/light\]","<span style=""behavior:url(inc/font.htc)"">$1</span>")
If InStr(Lcase(Str),"[em")>0 Then re.pattern="\[em*([0-9]*)]":str=re.replace(str,"<img src=pic/emot/em$1.gif>")
If InStr(Lcase(Str),"[/size]")>0 Then Str=IUBB1(Str,"\[size=([1-7])\]","\[\/size\]","<font size=$1>$2</font>")
If InStr(Lcase(Str),"[/fly]")>0 Then Str=IUBB1(Str,"\[fly\]","\[\/fly\]","<marquee width=90% behavior=alternate scrollamount=3>$1</marquee>")
If InStr(Lcase(Str),"[/move]")>0 Then Str=IUBB1(Str,"\[move\]","\[\/move\]","<MARQUEE scrollamount=3>$1</marquee>")
If InStr(Lcase(Str),"[/aling]")>0 Then Str=IUBB1(Str,"\[align=(center|left|right)\]","\[\/align\]","<div align=$1>$2</div>")
If InStr(Lcase(Str),"[/shadow]")>0 Then Str=IUBB1(Str,"\[shadow=*([0-9]*),*(#*[a-z0-9]*),*([0-9]*)\]","\[\/shadow\]","<table width=$1 ><tr><td style=""filter:shadow(color=$2, stregExngth=$3)"">$4</td></tr></table>")
If InStr(Lcase(Str),"[/sound]")>0 Then Str=IUBB1(Str,"\[sound\]","\[\/sound\]","<a href=""$2"" target=_blank><IMG SRC=Pic/FileType/mid.gif border=0 alt='背景音乐'></a><bgsound src=""$2"" loop=""-1"">")
If InStr(Lcase(Str),"[/img]")>0 Then Str=IUBB2(Str,"\[img\]","\[\/img\]","<img border=""0"" src=""$1"" />","<a href=$1 target=_blank>$1</a>",BBS.Info(65))
If InStr(Lcase(Str),"[/email]")>0 Then
re.pattern="\[EMAIL\]([^\s@]+@[^\.]+\..+?)\[\/EMAIL\]"
str=re.replace(str,"<a href=""mailto:$1"" target='_blank'>$1</a>")
re.pattern="\[EMAIL=([^\s@]+@[^\.]+?\..+?)\](.+?)\[\/EMAIL\]"
str=re.replace(str,"<a href=""mailto:$1"" target='_blank'>$2</a>")
End If
Str=JsImg(Str,550)
Sign_Code=Str
End Function
Private Function text_encode(byval str)
If isnull(str) then
text_encode=""
Else
re.Pattern="(<br></p>)"
're.Pattern="(<\/p>"&vbNewLine&"<P>)"
Str=re.Replace(Str,chr(10))
re.Pattern="(<br>|<p><\/p>|<p>|<\/p>)"
Str=re.Replace(Str,chr(10))
text_encode=replace(str," "," ")
End if
End function
Private Function IUBB1(Str,uCodeL,uCodeR,tCode)
Dim s
s=str
re.Pattern=uCodeL&uCodeR
s=re.Replace(s,"")
re.Pattern=uCodeL&"(.+?)"&uCodeR
s=re.Replace(s,tCode)
re.Pattern=uCodeL
s=re.Replace(s,"")
re.Pattern=uCodeR
s=re.Replace(s,"")
IUBB1=s
End Function
Private Function IUBB3(Str,uCodeL,uCodeR,tCode)
Dim s
s=str
re.Pattern=uCodeL&uCodeR
s=re.Replace(s,"")
re.Pattern=uCodeL&"(.+?)"&uCodeR
s=re.Replace(s,tCode)
re.Pattern=uCodeL
s=re.Replace(s,"")
re.Pattern=uCodeR
s=re.Replace(s,"")
IUBB3=s
End Function
Private Function IUBB2(Str,uCodeL,uCodeR,tCode1,tCode2,BBSCheck)
Dim s
s=str
re.Pattern=uCodeL&uCodeR
s=re.Replace(s,"")
re.Pattern=uCodeL&"(.+?)"&uCodeR
If BBScheck="1" Then
s=re.Replace(s,tCode1)
Else
s=re.Replace(s,tCode2)
End If
IUBB2=s
End Function
Private Function BBS_HtmlCode(Str,PostType)
dim ary_String,i,n,n_pos
ary_String=split(Str,"[code]")
n=ubound(ary_String)
If n<1 then
BBS_HtmlCode=IUBB(Str,PostType)
Exit function
End If
ary_String(0)=IUBB(ary_String(0),postType)
for i=1 to n
n_pos=inStr(ary_String(i),"[/code]")
If n_pos>0 then
ary_String(i)="<form><div style='border:solid 1px #6D683D;background-color:#AAA'><div style='text-align :center;'><textarea style='border:solid 1px #EEE;width:99%;' name='dbg' rows='10' id='dbg"&i&"'>" & text_encode(left(ary_String(i),n_pos-1)) & "</textarea></div> <div style='float:right;text-align :right'><img src='Images/icon/plus.gif' style='cursor:pointer' onclick=""code_Size(5,document.getElementById('dbg"&i&"'))"" alt='增加编辑框的高度' /> <img src='Images/icon/minus.gif' style='cursor:pointer' onclick=""code_Size(-5,document.getElementById('dbg"&i&"'))"" alt='减小输入框的高度' /> </div><div><input type='button' class='button' value='运行此代码' style='width:80px' onclick='runit(this.form.dbg)'> <input type='button' class='button' value='复制到剪贴板' style='width:90px' onclick='copyit(this.form.dbg)'> <input type='button' class='button' value='代码另存为' style='width:80px' onclick='saveAs(this.form.dbg)'></div></div></form>" & IUBB(right(ary_String(i),len(ary_String(i))-n_pos-6),PostType)
Else
ary_String(i)="[code]" & IUBB(ary_String(i),PostType)
End if
next
BBS_HtmlCode=join(ary_String,"")
End Function
Rem 入口（内容,开始的UBB，结束的UBB，显示允许，显示不允许，标记：1=帖子/2=留言公告，类型）
Private Function BBS_GetUBB(Str,uCodeL,uCodeR,tCode1,tCode2,postType,Btype)
Dim Test
Dim po,ii
Dim LoopCount
Dim MyInfo
LoopCount=0
Do While True
re.Pattern=uCodeL
Test=re.Test(Str)
If Test Then
re.Pattern=uCodeR
Test=re.Test(Str)
If Test Then
If PostType=1 Then
re.Pattern="(^.*)("&uCodeL&")(.+?)("&uCodeR&")(.*)"
po=re.Replace(Str,"$3")
If IsNumeric(po) Then
ii=int(po)
Else
ii=0
End If
If Not BBS.Founduser Then
Str=re.Replace(str,tCode2)
Else
Select Case BType
Case 32
MyInfo=Session(CacheName & "MyInfo")(7)
Case 33
MyInfo=Session(CacheName & "MyInfo")(6)
Case 34
MyInfo=Session(CacheName & "MyInfo")(15)
End Select
If Lcase(BBS.MyName)=Lcase(UserName) or int(MyInfo)>=int(ii) or Session(CacheName&"MyGradeInfo")(39)="1" or BBS.IsBoardAdmin Then
Str=re.Replace(str,tCode1)
Else
Str=re.Replace(str,tCode2)
End If
End If
Else
re.Pattern="("&uCodeL&")(.+?)("&uCodeR&")"
s=re.Replace(s,"$3")
End If
Else
Exit Do
End If
Else
Exit Do
End If
LoopCount=LoopCount + 1
If LoopCount>MaxLoopCount Then Exit Do
Loop
BBS_GetUBB=Str
End Function
Private Function IUBB_Login(Str,PostType)
Dim Test
Dim LoopCount
LoopCount=0
Do While True
re.Pattern="\[login\]"
Test=re.Test(Str)
If Test Then
re.Pattern="\[\/login\]"
Test=re.Test(Str)
If Test Then
re.Pattern="(^.*)(\[login\])(.+?)(\[\/login\])(.*)"
If BBS.FoundUser Then
Str=re.Replace(str,"$1<hr size=1><font color=#A2A2A2>此帖内容<b>必须登陆</b>后才能浏览</font><BR>$3</font><hr size=1>$5")
Else
Str=re.Replace(str,"$1<hr size=1><font color=Red>此帖内容<b>必须<a href=login.asp>登陆</a></b>后才能浏览<BR></font><hr size=1>$5")
End if
Else
Exit Do
End If
Else
Exit Do
End If
LoopCount=LoopCount + 1
If LoopCount>MaxLoopCount Then Exit Do
Loop
IUBB_Login=Str
End Function
Private Function IUBB_Sex(Str,PostType)
Dim Test
Dim LoopCount
Dim Tmp_Str,po
LoopCount=0
Do While True
re.Pattern="\[sex=*([0-1]*)\]"
Test=re.Test(Str)
If Test Then
re.Pattern="\[\/sex\]"
Test=re.Test(Str)
If Test Then
re.Pattern="(^.*)(\[sex=*([0-1]*)\])(.+?)(\[\/sex\])(.*)"
If PostType=1 Then
po=re.replace(str,"$3")
If isnumeric(po) then
If int(po)=0 then Tmp_Str="女"
If int(po)=1 then Tmp_Str="男"
If Not BBS.FoundUser Then
str=re.Replace(str,"$1<hr size=1><font color=Red>此内容需要性别为<font color=red> <b>"&Tmp_Str&"</b></font> 和作者才能浏览：</font><BR><hr size=1>$6")
Else
If (Session(CacheName & "MyInfo")(3)="1" And int(po)=1) or (Session(CacheName & "MyInfo")(3)="0" And int(po)=0) or Lcase(BBS.MyName)=Lcase(UserName) Then
str=re.Replace(str,"$1<hr size=1><font color=#A2A2A2>此内容需要性别为<font color=red> <b>"&Tmp_Str&"</b></font> 和作者才能浏览：</font><BR>$4<hr size=1>$6")
Else
str=re.Replace(str,"$1<hr size=1><font color=Red>此内容需要性别为<font color=red> <b>"&Tmp_Str&"</b></font> 和作者才能浏览：</font><BR><hr size=1>$6")
End If
End If
End if
Else
Str=re.Replace(str,"$4")
End If
Else
Exit Do
End If
Else
Exit Do
End If
LoopCount=LoopCount + 1
If LoopCount>MaxLoopCount Then Exit Do
Loop
IUBB_Sex=Str
End Function
Private Function IUBB_Name(Str,PostType)
Dim Test
Dim LoopCount
Dim Tmp_My,tmp_str,I
LoopCount=0
Do While True
re.Pattern="\[username=(.[^\[]*)\]"
Test=re.Test(Str)
If Test Then
re.Pattern="\[\/username\]"
Test=re.Test(Str)
If Test Then
re.Pattern="(^.*)(\[username=(.[^\[]*)\])(.+?)(\[\/username\])(.*)"
If PostType=1 Then
Tmp_Str=re.replace(str,"$3")
Tmp_Str=split(Tmp_Str,",")
Tmp_My=False
For i=0 to ubound(Tmp_Str)
If lcase(BBS.MyName)=lcase(Tmp_Str(i)) then Tmp_My=True:Exit For
Next
If Tmp_My or Lcase(BBS.MyName)=Lcase(UserName) Then
Str=re.Replace(str,"$1<hr size=1><font color=#A2A2A2>此内容只有作者和 <b>$3</b> 能浏览：</font><BR>$4<hr size=1>$6")
Else
Str=re.Replace(str,"$1<hr size=1><font color=Red>此内容只有作者和 <b>$3</b> 能浏览：</font><BR><hr size=1>$6")
End if
Else
Str=re.Replace(str,"$4")
End If
Else
Exit Do
End If
Else
Exit Do
End If
LoopCount=LoopCount + 1
If LoopCount>MaxLoopCount Then Exit Do
Loop
IUBB_Name=Str
End Function
Private Function IUBB_Reply(Str,PostType)
Dim Test
Dim LoopCount
LoopCount=0
Do While True
re.Pattern="\[reply\]"
Test=re.Test(Str)
If Test Then
re.Pattern="\[\/reply\]"
Test=re.Test(Str)
If Test Then
re.Pattern="(^.*)(\[reply\])((.|\n)+?)(\[\/reply\])(.*)"
IF PostType=1 Then
If Not BBS.FoundUser Then
str=re.Replace(str,"$1<hr size=1><font color=Red>此内容只有作者和已经回复此帖的浏览者能浏览：</font><BR><hr size=1>$6")
Else
If SESSION(CacheName& "MyGradeInfo")(39)="1" or Lcase(BBS.MyName)=Lcase(UserName) or Not BBS.execute("select BbsID From[bbs"&BBS.TB&"] where ReplyTopicID="&ID&" and name='"&BBS.MyName&"'").eof then
str=re.Replace(str,"$1<hr size=1><font color=Red>此内容只有作者和已经回复此帖的浏览者能浏览：</font><BR>$3<hr size=1>$6")
Else
str=re.Replace(str,"$1<hr size=1><font color=Red>此内容只有作者和已经回复此帖的浏览者能浏览：</font><BR><hr size=1>$6")
End if
End If
Else
str=re.Replace(str,"$3")
End If
Else
Exit Do
End If
Else
Exit Do
End If
LoopCount=LoopCount + 1
If LoopCount>MaxLoopCount Then Exit Do
Loop
IUBB_Reply=Str
End Function
Private Function IUBB_Date(Str,PostType)
Dim Tmp_int,Tmp_My,tmp_str
Dim Test
Dim LoopCount
LoopCount=0
Do While True
re.Pattern="\[date=(.[^\[]*)\]"
Test=re.Test(Str)
If Test Then
re.Pattern="\[\/date\]"
Test=re.Test(Str)
If Test Then
re.Pattern="(^.*)(\[date=(.[^\[]*)\])(.+?)(\[\/date\])(.*)"
IF PostType=1 Then
Tmp_Str=re.replace(str,"$3")
If IsDate(Tmp_Str) Then Tmp_Int=Datediff("d",cdate(Tmp_Str),cdate(BBS.NowBbsTime)) Else Tmp_Int=-1
If int(Tmp_Int)>0 Then
Str=re.Replace(Str,"$1<hr size=1><font color=Red>此内容只有：<b>"&Tmp_Str&"</b>这天以后才能浏览：</font><BR>$4<hr size=1>$6")
Else
Str=re.Replace(str,"$1<hr size=1><font color=Red>此内容只有：<b>"&Tmp_Str&"</b>这天以后才能浏览：</font><BR><hr size=1>$6")
End If
Else
Str=re.Replace(str,"$1")
End If
Else
Exit Do
End If
Else
Exit Do
End If
LoopCount=LoopCount + 1
If LoopCount>MaxLoopCount Then Exit Do
Loop
IUBB_Date=Str
End Function
Private Function IUBB_Buy(Str,PostType)
Dim Tmp_int,Tmp_My,tmp_str,i,Buy_Rs
Dim Test
Dim LoopCount
LoopCount=0
Do While True
re.Pattern="\[buypost=*([0-9]*)\]"
Test=re.Test(Str)
If Test Then
re.Pattern="\[\/buypost\]"
Test=re.Test(Str)
If Test Then
re.Pattern="(^.*)(\[buypost=*([0-9]*)\])(.+?)(\[\/buypost\])(.*)"
If PostType=1 Then
If Not BBS.FoundUser Then
Str=re.Replace(str,"$1<hr size=1><font color=Red>此内容要求金钱数达到$3以上才可以购买并浏览</font><hr noshade size=1>$6")
Else
Tmp_My="<Form style='margin:0px;' action='Submit.asp?Action=buy' method='Get'><input type=hidden value="&BbsID&" name='ID'><input type=hidden value="&BBS.TB&" name='TB'><input type=submit value='好黑啊…我…我买了！'></form>"
Tmp_Int=re.Replace(str,"$3")
If isnumeric(Tmp_Int) Then Tmp_Int=int(Tmp_Int) Else Tmp_Int=0
Tmp_Str=""
If BBSID<>0 Then
Set Buy_Rs=BBS.execute("select Username From[Buyer] where BbsID="&BbsID)
If Not Buy_Rs.Eof Then
Tmp_Str=Buy_Rs(0)
End If
Buy_Rs.close
Set Buy_Rs=Nothing
End If
If Lcase(BBS.MyName)=Lcase(UserName) or SESSION(CacheName&"MyGradeInfo")(39)="1" Or BBS.IsBoardAdmin Then
Dim PostBuyUser
If Tmp_Str<>"" then
Tmp_Str=split(Tmp_Str,"|")
PostBuyUser=""
For i=0 to ubound(Tmp_Str)
PostBuyUser=PostBuyUser & "<option value="&i&">"&Tmp_Str(i)&"</option>"
Next
PostBuyUser="<select name=buyuser size=1><option value=0>共有"&ubound(Tmp_Str)+1&"位用户购买</option>"&PostBuyUser & "</select>"
Else
PostBuyUser="<select name=buyuser size=1><option value=0>还没有用户购买</option></select>"
End if
If BBS.MyName<>UserName Then PostBuyUser=Tmp_My&PostBuyUser
Str=re.Replace(str,"$1<hr size=1><font color=Red>以下为需要金钱数达到<B>$3</B>才能浏览的内容</font> "&PostBuyUser&"<BR>$4<hr size=1>$6")
Else
If instr("|"&Tmp_Str&"|","|"&BBS.MyName&"|")>0 then
Str=re.Replace(str,"$1<hr noshade size=1>以下为需要花 <del><B>$3</B></del> 金钱才能购买并浏览的内容，您已经购买本帖<BR>$4<hr noshade size=1>$6")
Else
If Int(Session(CacheName & "MyInfo")(7))>Tmp_Int then
str=re.Replace(str,"$1<hr size=1><font color=Red>此帖子内容需要您花 <B>$3</B> 金钱来购买浏览 "&Tmp_My&"</font><hr size=1>$6")
Else
str=re.Replace(str,"$1<hr size=1><font color=Red>此内容要求金钱数达到 <B>$3</B> 以上才可以购买并浏览</font><hr size=1>$6")
end if
End if
End if
End if
Else
Str=re.Replace(str,"$4")
End If
Else
Exit Do
End If
Else
Exit Do
End If
LoopCount=LoopCount + 1
If LoopCount>MaxLoopCount Then Exit Do
Loop
IUBB_Buy=Str
End Function
End Class
</script>